Also see core-practices-over-time.html.
dat <- import(here("data/longitudinal", "full-tags-wide.csv"))
dictionary <- import(here("data/2024 data", "dictionary_2024.csv"))
source(here("scripts/branding.R"))core_prac <- dat %>%
select(school_id, year, starts_with("core")) %>%
mutate(school_id = as.factor(school_id),
year = as.factor(year))
core_prac[is.na(core_prac)] <- 0
core_prac <- core_prac %>%
# summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE))) %>%
pivot_longer(starts_with("core"),
names_to = "core_practice",
values_to = "times_selected")
core_prac_dat <- core_prac %>%
group_by(core_practice) %>%
summarise(selected = sum(times_selected)) %>%
arrange(-selected)First note: there are 26 practices that have never been selected as a core practice. They are the following:
no_core <- core_prac_dat %>%
filter(selected == 0) %>%
mutate(core_practice = sub("core_", "", core_practice)) %>%
pull(core_practice)
no_core## [1] "data_instruction" "design_margins"
## [3] "devices_home" "ell_supports"
## [5] "equity_plan" "experiential"
## [7] "flexible_schedule" "graduation_supports"
## [9] "hiring_practices" "immigrants_supports"
## [11] "information_formats" "learner_agency"
## [13] "local_global" "maker"
## [15] "measures_climate" "measures_college"
## [17] "measures_purpose" "oer"
## [19] "other_leaders" "poverty_supports"
## [21] "quality_materials" "relevant_learning"
## [23] "rigorous_coursework" "sel_plan"
## [25] "staffing_infrastructure" "wraparound"
These are the rest.
Let’s look more closely at the top 10 on this list.
top_core <- core_prac_dat %>%
head(10) %>%
pull(core_practice)
top_core_dat <- core_prac %>%
filter(core_practice %in% top_core) %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected))top_core_dat %>%
filter(year != 2019) %>%
ggplot(aes(reorder(core_practice, selected), selected, fill = year)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom"
) It looks like 2021 was really driving the top core practices list across the years.
tags_2019 <- full_tags_long %>%
filter(year == 2019) %>%
group_by(var) %>%
summarise(`2019` = sum(usage), .groups = "drop") #173 schools
tags_2021 <- full_tags_long %>%
filter(year == 2021) %>%
group_by(var) %>%
summarise(`2021` = sum(usage), .groups = "drop") #232 schools
tags_2022 <- full_tags_long %>%
filter(year == 2022) %>%
group_by(var) %>%
summarise(`2022` = sum(usage), .groups = "drop") #161 schools
tags_2023 <- full_tags_long %>%
filter(year == 2023) %>%
group_by(var) %>%
summarise(`2023` = sum(usage), .groups = "drop") #251 schools
tags_2024 <- full_tags_long %>%
filter(year == 2024) %>%
group_by(var) %>%
summarise(`2024` = sum(usage), .groups = "drop") #189 schools# Create a dataframe with variables and their years
tags_list <- list(
`2019` = tags_2019 %>% pull(var) %>% unique(),
`2021` = tags_2021 %>% pull(var) %>% unique(),
`2022` = tags_2022 %>% pull(var) %>% unique(),
`2023` = tags_2023 %>% pull(var) %>% unique(),
`2024` = tags_2024 %>% pull(var) %>% unique()
)
# Combine the list into a long dataframe
tags_df <- bind_rows(
lapply(names(tags_list), function(year) {
data.frame(variable = tags_list[[year]], year = as.integer(year))
})
)
# Summarize the number of years each variable is used and list the years used
variable_usage <- tags_df %>%
group_by(variable) %>%
summarise(
number_of_years_used = n_distinct(year),
years_used = paste(sort(unique(year)), collapse = ", ")
)Now, let’s look more closely at the tags that have never been selected as core.
variable_usage %>%
mutate(variable = sub("practices_", "", variable)) %>%
filter(variable %in% no_core) %>%
datatable()Looks like all are from 2019 except other_leaders, which
is from 2023.
Here is the rest of them.
Well, this is an interesting question given that 2021 seems like it was the year that schools were more liberal with their core practice selections, so I imagine this affects most practices. But let’s look at them below.
p <- core_prac %>%
group_by(core_practice, year) %>%
summarise(selected = sum(times_selected)) %>%
filter(year != 2019) %>%
mutate(year = as.numeric(year)) %>%
ggplot(aes(year, selected, color = core_practice)) +
geom_point() +
geom_line() +
scale_fill_manual(values = transcend_cols2) +
scale_y_continuous(expand = c(0,0)) +
labs(title = "Core Practices by Year Implemented",
x = "",
y = "") +
# scale_x_discrete(labels = label_tags()) +
theme(legend.position = "none",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
theme(
panel.grid.major.y = element_blank(),
legend.position = "none"
)
ggplotly(p, tooltip = c("core_practice", "selected"))clean_labels <- import(here("data/longitudinal", "tag-labels.csv"))
variable_usage_by_year <- tags_2019 %>%
full_join(tags_2021, by = "var") %>%
full_join(tags_2022, by = "var") %>%
full_join(tags_2023, by = "var") %>%
full_join(tags_2024, by = "var") %>%
left_join(clean_labels, by = c("var" = "variable"))Filter to tags that have been used at least 4 years.
Are we seeing a lot of “brand new” practices piloted, are schools more or less trying out “established” practices, or both?
load(here("data/2024 data", "complete_canopy_2024.RData"))
old_clusters <- import(here("data/clusters_through_2024.csv"))pilot_prac <- tags %>%
select(starts_with("pilot")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N",
names_prefix = "pilot_") %>%
group_by(practice) %>%
summarise(selected = sum(N))These are the practices by time implemented:
implementation_time <- tags %>%
select(starts_with("time_")) %>%
pivot_longer(everything(),
names_to = "practice",
values_to = "N") %>%
mutate(`Not sure` = case_when(N == "Not sure" ~ 1,
TRUE ~ 0),
`Less than a year` = case_when(N == "Less than a year" ~ 1,
TRUE ~ 0),
`1-2 years` = case_when(N == "1-2 years" ~ 1,
TRUE ~ 0),
`3-4 years` = case_when(N == "3-4 years" ~ 1,
TRUE ~ 0),
`5+ years` = case_when(N == "5+ years" ~ 1,
TRUE ~ 0),
practice = sub("time_", "", practice)) %>%
select(!N) %>%
group_by(practice) %>%
summarise(across(where(is.numeric), ~ sum(.x, na.rm = TRUE)))
# Plot dat setup
implementation_time_plot <- implementation_time %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
# Practice axes setup
cluster_colors <- unique(old_clusters$cluster) %>%
setNames(object = c(transcend_cols2[c(1, 2, 4, 5)], "#000000"))
clusters <- old_clusters %>%
mutate(practice = sub("practices_", "", var)) %>%
select(-var)
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
# Plot (referenced Gregor's code)
ggplot(implementation_with_color, aes(reorder(practice, N), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)Now let’s sort by pilot practice selection (descending).
# Plot dat setup
implementation_time_plot <- time_pilot %>%
pivot_longer(cols = c(`Less than a year`, `1-2 years`, `3-4 years`, `5+ years`),
names_to = "time",
values_to = "N") %>%
mutate(time = factor(time, levels = c(
"Less than a year",
"1-2 years",
"3-4 years",
"5+ years"
)))
implementation_with_color <- left_join(implementation_time_plot, clusters, by = "practice") %>%
mutate(
color = cluster_colors[cluster],
practice = fct_inorder(glue("<i style='color:{color}'>{practice}</i>"))
)
ggplot(implementation_with_color, aes(reorder(practice, selected), N, fill = time)) +
geom_col() +
scale_fill_manual(values = transcend_cols) +
scale_y_continuous(limits=c(0, 85), expand = c(0,0)) +
labs(title = "Core Practices by Time Implemented, From Most to Least Selected to Pilot",
x = "",
y = "") +
scale_x_discrete(labels = label_tags()) +
theme(legend.position = "bottom",
legend.direction = "horizontal",
text = element_text(size = 7),
axis.text.x = element_text(angle = 45, hjust = 1)) +
coord_flip() +
theme(
panel.grid.major.y = element_blank(),
legend.position = "bottom",
axis.text.y = element_markdown()
)